home *** CD-ROM | disk | FTP | other *** search
-
- unit S3;
-
- {#Z+}
-
- { S3 Version 2.00 01.01.1995 Dietmar Meschede }
- { }
- { Copyright (c) 1993,1995 Dietmar Meschede }
- { }
- { Use at OWN risk! }
-
- {#Z-}
-
- { The main purpose of this unit is to set up a 320x240x256 or }
- { 640x480x256 video mode with a 1 MByte linear address window. }
- { }
- { The unit requires a S3 86C928 (or better) graphic chip and }
- { runs only in proteced mode. }
-
- {$DEFINE PROTECTED}
- {$I STDUNIT.OPT}
-
- interface
-
- uses
- NewFrontier, VESA;
-
- var
- S3VideoLinearAddress: Longint;
- S3Video, S3Video32: TSelector;
-
- const
- SETUP_OS = $0102;
- SETUP_VSE = $46E8;
-
- procedure UnlockS3Regs;
- procedure LockS3Regs;
-
- procedure S3Init320x240;
- procedure S3Init640x480;
-
- procedure DoneS3;
-
- procedure S3SetStartAddress(Start: Longint);
-
- implementation
-
- { Linear Address Window Control Register (CR58): }
-
- { Bits 1-0: LAW-SIZE - Linear Address Window Size }
- { 00 = 64 KB, 01 = 1 MB, 10 = 2MB, 11 = 4MB }
- { Bit 4: Enable Linear Addressing }
-
- { Linear Address Window Position Registers (CR59-5A): }
-
- { Bits 9-0: LINEAR ADDRESS-WINDOW-POSITION }
- { Linear Address Window Position bits 25-16 }
- { LAW-Size = 1 MB: bits 19-16 ignored }
- { LAW-Size = 2 MB: bits 20-16 ignored }
- { LAW-Size = 4 MB: bits 21-16 ignored }
-
- procedure UnlockS3Regs; { Enables access to all S3 registers }
- begin
- WriteReg(CR, $38, $48);
- WriteReg(CR, $39, $A0);
- end; { UnlockS3Regs }
-
- procedure LockS3Regs; { Disables access to extended S3 registers }
- begin
- WriteReg(CR, $38, $00);
- WriteReg(CR, $39, $00);
- end; { LockS3Regs }
-
- procedure S3Init320x240;
- const
- CrtRegs: array[0..$18] of Byte =
- ($5F, $4F, $50, $82, $54, $80, $0D, $3E,
- $00, $41, $00, $00, $00, $00, $00, $00,
- $EA, $2C, $DF, $40, $40, $E7, $06, $A3, $FF);
- var
- i: Byte;
- begin
- SetVideoMode($13); { Init VGA Mode 13h }
-
- WriteReg(SR, $01, ReadReg(SR, $01) or $20); { Turn screen off }
-
- Port[MISC_WT] := $E7; { Init Tweak Mode 320x240 }
- WriteReg(CR, $11, ReadReg(CR, $11) and $7F); { with logical line width 512 }
- for i := $00 to $18 do
- WriteReg(CR, i, CrtRegs[i]);
- WriteReg(CR, $11, ReadReg(CR, $11) or $80);
-
- UnlockS3Regs;
-
- WriteReg(CR, $31, $8D); { Force Enhanced Mode Mappings }
-
- WriteReg(CR, $54, $01); { Read Ahead Extra Prefetch = 1 }
-
- WriteReg(CR, $58, $00); { Disable Linear Addressing (!) and other }
-
- WriteReg(CR, $59, $03); { Linear Address Window Position = 3000000h }
- WriteReg(CR, $5A, $00);
-
- WriteReg(CR, $58, $1D); { Enable Read Ahead Cache & Linear Addressing }
- { Linear Address Window Size = 1 MByte }
-
- LockS3Regs;
-
- FillChar32(Ptr48(S3Video, 0), $10000, 0); { Clear S3Video memory !!! }
-
- WriteReg(SR, $01, ReadReg(SR, $01) and $DF); { Turn screen on }
- end; { S3Init320x240 }
-
- procedure S3Init640x480;
- begin
- WriteReg(SR, $01, ReadReg(SR, $01) or $20); { Turn screen off }
-
- UnlockS3Regs;
- WriteReg(CR, $58, $00); { Disable Read Ahead Cache & Linear Addressing }
- WriteReg(CR, $59, $00); { Linear Address Window Position = 00A0000h }
- WriteReg(CR, $5A, $0A);
- LockS3Regs;
-
- SetSuperVGAVideoMode($101); { Init VESA Mode 101h }
-
- WriteReg(SR, $01, ReadReg(SR, $01) or $20); { Turn screen off }
-
- WriteReg(CR, $13, $80); { Logical line width 1024 }
-
- UnlockS3Regs;
-
- WriteReg(CR, $40, ReadReg(CR, $40) or $08); { Enable Fast Write Buffer }
-
- WriteReg(CR, $58, $00); { Disable Linear Addressing (!) and other ... }
-
- WriteReg(CR, $59, $03); { Linear Address Window Position = 3000000h }
- WriteReg(CR, $5A, $00);
-
- WriteReg(CR, $58, $1D); { Enable Read Ahead Cache & Linear Addressing }
- { Linear Address Window Size = 1 MByte }
-
- LockS3Regs;
-
- FillChar32(Ptr48(S3Video, 0), $10000, 0); { Clear S3Video memory !!! }
-
- WriteReg(SR, $01, ReadReg(SR, $01) and $DF); { Turn screen on }
- end; { S3Init640x480 }
-
- procedure DoneS3;
- begin
- WriteReg(SR, $01, ReadReg(SR, $01) or $20); { Turn screen off }
-
- UnlockS3Regs;
- WriteReg(CR, $58, $00); { Disable Read Ahead Cache & Linear Addressing }
- WriteReg(CR, $59, $00); { Linear Address Window Position = 00A0000h }
- WriteReg(CR, $5A, $0A);
- LockS3Regs;
-
- SetVideoMode($03); { Init Text Mode 03h }
- end; { DoneS3 }
-
- procedure S3SetStartAddress(Start: Longint);
- begin
- Start := Start shr 2;
- UnlockS3Regs;
- WriteReg(CR, $0D, $00);
- WriteReg(CR, $0D, Byte(Start));
- WriteReg(CR, $0C, Byte(Start shr 8));
- WriteReg(CR, $31, (ReadReg(CR, $31) and $CF) or (Byte(Start shr 12) and $30));
- WriteReg(CR, $51, (ReadReg(CR, $51) and $FC) or (Byte(Start shr 18) and $03));
- LockS3Regs;
- end; { S3SetStartAddress }
-
- var
- SaveExit: Pointer;
-
- procedure S3Exit; far;
- begin
- ExitProc := SaveExit;
- FreeDescriptor(S3Video32);
- FreeDescriptor(S3Video);
- end; { S3Exit }
-
- var
- Rights: Word;
-
- begin
- S3Video := 0; S3Video32 := 0;
- SaveExit := ExitProc;
- ExitProc := @S3Exit;
- S3VideoLinearAddress := PhysicalAddressMapping($3000000, $100000);
- S3Video := CreateDescriptor(S3VideoLinearAddress, $100000);
- Rights := GetSegmentAccessRights(S3Video);
- Rights := (Rights and $FF70) or $0093;
- SetSegmentAccessRights(S3Video, Rights);
- S3Video32 := CreateData32Alias(S3Video);
- end. { unit S3 }
-